HPAVC/HPAVC CD-ROM.iso/OOPTUT34.ZIP/COLLECT.PAS

Pascal/Delphi Source File | 1993-06-14 | 5KB | 168 lines

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X-}
{$M 16384,0,3000}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{   Turbo Pascal 6.0    Demo program from the Turbo Vision Guide         }
{                                                                        }
{   TVGUID17.PAS        Copyright (c) 1990 by Borland International      }
{                                                                        }
{   Modified  9.8.91   and again  19.11.92      R Shaw                   }
{                                                                        }
{   Demo program from the Turbo Vision Guide to illustrate the use of    }
{   Collections. The original Borland program has been modified to check }
{   memory for a collection of objects (clients) using DOS Debug from    }
{   the program by means of the Exec procedure.                          }
{                                                                        }
{   COLLECT.PAS  ->  .EXE                                                }
{________________________________________________________________________}

program COLLECT;

uses DOS, Objects, Crt, Hex;

type
  PClient = ^TClient;
  TClient = object(TObject)
    Account, Name, Phone: PString;
    constructor Init(NewAccount, NewName, NewPhone: String);
    destructor Done; virtual;
    procedure Print; virtual;
  end;

{ TClient }
constructor TClient.Init(NewAccount, NewName, NewPhone: String);
begin
  Account := NewStr(NewAccount);
  Name := NewStr(NewName);
  Phone := NewStr(NewPhone);
end;

destructor TClient.Done;
begin
  DisposeStr(Account);
  DisposeStr(Name);
  DisposeStr(Phone);
end;

procedure TClient.Print;
begin
  Writeln('  ',
    Account^, '':10-Length(Account^),
    Name^, '':20-Length(Name^),
    Phone^, '':16-Length(Phone^));
end;

{ Use ForEach iterator to display client information }

procedure PrintAll(C: PCollection);

procedure CallPrint(P : PClient); far;
begin
  P^.Print;                   { Call Print method }
end;

begin { Print }
  Writeln;
  Writeln('Client list:');
  C^.ForEach(@CallPrint);     { Print each client }
end;

{ Use FirstThat iterator to search non-key field }

procedure SearchPhone(C: PCollection; PhoneToFind: String);

function PhoneMatch(Client: PClient): Boolean; far;
begin
  PhoneMatch := Pos(PhoneToFind, Client^.Phone^) <> 0;
end;

var
  FoundClient: PClient;

begin { SearchPhone }
  Writeln;
  FoundClient := C^.FirstThat(@PhoneMatch);
  if FoundClient = nil then
    Writeln('No client met the search requirement')
  else
  begin
    Writeln('Found client:');
    FoundClient^.Print;
  end;
end;


Function DebugPath : Pathstr;

var
  DPath : PathStr;

begin
  DPath := '';
  DPath := FSearch('DEBUG.EXE', GetEnv('PATH'));
  If DPath = '' then DPath := FSearch('DEBUG.COM', GetEnv('PATH'));
  If DPath = '' then
     begin
        writeln('DEBUG file not found. Please check your DOS system.');
        writeln;
        writeln('Press any key to continue: ');
        repeat until keypressed;
     end;
  DebugPath := DPath;
end;      {of Function DebugPath}


var
  ClientList: PCollection;

  reply     : char;
  HeapOrgSeg,HeapOrgOfs          : word;
  HeapOrgSegX,HeapOrgOfsX        : string;
  HeapPtrSeg,HeapPtrOfs          : word;
  HeapPtrSegX,HeapPtrOfsX        : string;
  HeapOrg                        : ^integer;
  i                              : integer;

begin
  ClrScr;
  Writeln('CHECK OF MEMORY FOR A COLLECTION OF CLIENTS.');
  Writeln;
  Mark(HeapOrg);
  HeapOrgSeg := seg(HeapOrg^);
  HeapOrgOfs := ofs(HeapOrg^);
  for i := HeapOrgOfs to (HeapOrgOfs + 1000) do Mem[HeapOrgSeg:i] := 0;
  dec2hex(HeapOrgSeg,HeapOrgSegX);
  dec2hex(HeapOrgOfs,HeapOrgOfsX);
  writeln('HeapOrg:    ',HeapOrgSegX,':',HeapOrgOfsX);

  ClientList := New(PCollection, Init(10, 5));

  { Build collection }
  with ClientList^ do
  begin
    Insert(New(PClient, Init('90-177', 'Smith, John', '0987-4321')));
    Insert(New(PClient, Init('91-101', 'Jones, Gareth' , '0789-9876')));
    Insert(New(PClient, Init('91-102', 'McDonald, Ian' , '0788-1234')));
    Insert(New(PClient, Init('91-103', 'Kelly, Sean' , '0787-4567')));
    Insert(New(PClient, Init('91-104', 'Williams, David' , '0786-7654')));
  end;

  HeapPtrSeg := seg(HeapPtr^);
  HeapPtrOfs := ofs(HeapPtr^);
  dec2hex(HeapPtrSeg,HeapPtrSegX);
  dec2hex(HeapPtrOfs,HeapPtrOfsX);
  writeln('HeapPtr:    ',HeapPtrSegX,':',HeapPtrOfsX);

  { Use ForEach iterator to print all }
  PrintAll(ClientList);

  writeln;
  writeln('DOS Debug now entered from program by means of Exec procedure.');
  writeln('Please type D followed by a space and then the HeapOrg address, as above.');
  writeln('Then continue to type D until end of collection. Then type Q.');
  SwapVectors;
  Exec(DebugPath,'');
  If DosError <> 0 then writeln('Dos error # ',DosError);
  SwapVectors;
  Dispose(ClientList, Done);  { Clean up }
end.